home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Count the 197045172001.psc / modVBLineCount.bas < prev    next >
Encoding:
BASIC Source File  |  2001-05-16  |  2.9 KB  |  103 lines
  1. Attribute VB_Name = "modVBLineCount"
  2. Option Explicit
  3.  
  4. Global cCode As Long, cComments As Long
  5. Global cBlank As Long, cTotal As Long
  6.  
  7. Global cForms As Long, cModules As Long
  8. Global cClasses As Long
  9.  
  10. Public Function GetLineCount(ByVal File As String, ByRef CodeCount As Long, CommentCount As Long, BlankCount As Long)
  11.  
  12. Dim fName As String, fNum As Integer
  13. Dim strData As String, aFound As Boolean
  14.  
  15.   CodeCount = 0
  16.   CommentCount = 0
  17.   BlankCount = 0
  18.   
  19.   fName = File
  20.   fNum = FreeFile
  21.   
  22.   If fName = "" Then
  23.     MsgBox "Invalid File Name!", vbCritical, "Error"
  24.     Exit Function
  25.   End If
  26.   
  27.   Open fName For Input As fNum
  28.   
  29.   aFound = False
  30.   
  31.   Do Until EOF(fNum)
  32.   
  33.     Line Input #fNum, strData
  34.     
  35.     If Left(strData, 9) = "Attribute" And aFound = False Then
  36.       aFound = True
  37.     ElseIf Left(strData, 9) <> "Attribute" And aFound = True Then
  38.             
  39.       Call StripBeginingSpaces(strData)
  40.       If strData = "" Then
  41.         BlankCount = BlankCount + 1
  42.       ElseIf Left(strData, 1) = "'" Then
  43.         CommentCount = CommentCount + 1
  44.       Else
  45.         CodeCount = CodeCount + 1
  46.       End If
  47.       
  48.     End If
  49.     
  50.   Loop
  51.   
  52.   Close #fNum
  53.  
  54. End Function
  55.  
  56. Public Function StripBeginingSpaces(ByRef strData As String)
  57.  
  58.   Do Until Left(strData, 1) <> " "
  59.     strData = Right(strData, Len(strData) - 1)
  60.   Loop
  61.  
  62. End Function
  63.  
  64. Public Function GetFilePath(ByVal Data As String, ByVal FilePath As String)
  65.  
  66. Dim fPath As String, strData As String
  67. Dim x As Integer, fName As String
  68. Dim fDir As String, oas As New OpenSaveDialog
  69.  
  70.   strData = Data
  71.   fPath = FilePath
  72.   
  73.   If InStr(1, strData, "\") = 0 And InStr(1, strData, ";") = 0 Then
  74.     
  75.     x = InStr(1, strData, "=")
  76.     GetFilePath = fPath & Right(strData, Len(strData) - x)
  77.     
  78.   ElseIf InStr(1, strData, "\") = 0 And InStr(1, strData, ";") <> 0 Then
  79.   
  80.     x = InStr(1, strData, ";")
  81.     GetFilePath = fPath & Right(strData, Len(strData) - (x + 1))
  82.         
  83.   ElseIf InStr(1, strData, "\") <> 0 Then
  84.     
  85.     x = InStrRev(strData, "\")
  86.     fName = Right(strData, Len(strData) - x)
  87.     x = InStr(fPath, "\")
  88.     fDir = Left(fPath, x)
  89.     'Now that we have the filename, find the file
  90.     GetFilePath = FindFile(fDir, fName)
  91.     
  92.     'If we can't find the file on the current drive, ask the user to point it out to us
  93.     If GetFilePath = vbNullString Then
  94.       
  95.       MsgBox "The system could not find the file " & fName & " on your " & fDir & " directory.  Please select the file from the following window.", vbExclamation, "Cannot find file"
  96.       GetFilePath = oas.OpenDialogBox(frmMain, fCustom, "U:\VB", , "VB Forms (*.frm)" + Chr$(0) + "*.frm" + Chr$(0) + "VB Modules (*.bas)" + Chr$(0) + "*.bas" + Chr$(0) + "VB Class Modules (*.cls)" + Chr$(0) + "*.cls" + Chr$(0) + "All Files (*.*)" + Chr$(0) + "*.*" + Chr$(0))
  97.     
  98.     End If
  99.     
  100.   End If
  101.  
  102. End Function
  103.